home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl67.lha / tcl6.7 / tclTest.c < prev    next >
C/C++ Source or Header  |  1993-02-01  |  3KB  |  156 lines
  1. /* 
  2.  * tclTest.c --
  3.  *
  4.  *    Test driver for TCL.
  5.  *
  6.  * Copyright 1987-1991 Regents of the University of California
  7.  * All rights reserved.
  8.  *
  9.  * Permission to use, copy, modify, and distribute this
  10.  * software and its documentation for any purpose and without
  11.  * fee is hereby granted, provided that the above copyright
  12.  * notice appears in all copies.  The University of California
  13.  * makes no representations about the suitability of this
  14.  * software for any purpose.  It is provided "as is" without
  15.  * express or implied warranty.
  16.  */
  17.  
  18. #ifndef lint
  19. static char rcsid[] = "$Header: /user6/ouster/tcl/tclTest/RCS/tclTest.c,v 1.22 92/12/18 10:30:56 ouster Exp $ SPRITE (Berkeley)";
  20. #endif
  21.  
  22. #include <stdio.h>
  23. #include <errno.h>
  24. #include <string.h>
  25. #include <stdlib.h>
  26. #include "tcl.h"
  27.  
  28. Tcl_Interp *interp;
  29. Tcl_CmdBuf buffer;
  30. char dumpFile[100];
  31. int quitFlag = 0;
  32.  
  33. char initCmd[] =
  34.     "if [file exists [info library]/init.tcl] {source [info library]/init.tcl}";
  35.  
  36.     /* ARGSUSED */
  37. int
  38. cmdCheckmem(clientData, interp, argc, argv)
  39.     ClientData clientData;
  40.     Tcl_Interp *interp;
  41.     int argc;
  42.     char *argv[];
  43. {
  44.     if (argc != 2) {
  45.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  46.         " fileName\"", (char *) NULL);
  47.     return TCL_ERROR;
  48.     }
  49.     strcpy(dumpFile, argv[1]);
  50.     quitFlag = 1;
  51.     return TCL_OK;
  52. }
  53.  
  54.     /* ARGSUSED */
  55. int
  56. cmdEcho(clientData, interp, argc, argv)
  57.     ClientData clientData;
  58.     Tcl_Interp *interp;
  59.     int argc;
  60.     char *argv[];
  61. {
  62.     int i;
  63.  
  64.     for (i = 1; ; i++) {
  65.     if (argv[i] == NULL) {
  66.         if (i != argc) {
  67.         echoError:
  68.         sprintf(interp->result,
  69.             "argument list wasn't properly NULL-terminated in \"%s\" command",
  70.             argv[0]);
  71.         }
  72.         break;
  73.     }
  74.     if (i >= argc) {
  75.         goto echoError;
  76.     }
  77.     fputs(argv[i], stdout);
  78.     if (i < (argc-1)) {
  79.         printf(" ");
  80.     }
  81.     }
  82.     printf("\n");
  83.     return TCL_OK;
  84. }
  85.  
  86. int
  87. main()
  88. {
  89.     char line[1000], *cmd;
  90.     int result, gotPartial;
  91.  
  92.     interp = Tcl_CreateInterp();
  93. #ifdef TCL_MEM_DEBUG
  94.     Tcl_InitMemory(interp);
  95. #endif
  96.     Tcl_CreateCommand(interp, "echo", cmdEcho, (ClientData) "echo",
  97.         (Tcl_CmdDeleteProc *) NULL);
  98.     Tcl_CreateCommand(interp, "checkmem", cmdCheckmem, (ClientData) 0,
  99.         (Tcl_CmdDeleteProc *) NULL);
  100.     buffer = Tcl_CreateCmdBuf();
  101. #ifndef TCL_GENERIC_ONLY
  102.     result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
  103.     if (result != TCL_OK) {
  104.     printf("%s\n", interp->result);
  105.     exit(1);
  106.     }
  107. #endif
  108.  
  109.     gotPartial = 0;
  110.     while (1) {
  111.     clearerr(stdin);
  112.     if (!gotPartial) {
  113.         fputs("% ", stdout);
  114.         fflush(stdout);
  115.     }
  116.     if (fgets(line, 1000, stdin) == NULL) {
  117.         if (!gotPartial) {
  118.         exit(0);
  119.         }
  120.         line[0] = 0;
  121.     }
  122.     cmd = Tcl_AssembleCmd(buffer, line);
  123.     if (cmd == NULL) {
  124.         gotPartial = 1;
  125.         continue;
  126.     }
  127.  
  128.     gotPartial = 0;
  129.     result = Tcl_RecordAndEval(interp, cmd, 0);
  130.     if (result == TCL_OK) {
  131.         if (*interp->result != 0) {
  132.         printf("%s\n", interp->result);
  133.         }
  134.         if (quitFlag) {
  135.         Tcl_DeleteInterp(interp);
  136.         Tcl_DeleteCmdBuf(buffer);
  137. #ifdef TCL_MEM_DEBUG
  138.         Tcl_DumpActiveMemory(dumpFile);
  139. #endif
  140.         exit(0);
  141.         }
  142.     } else {
  143.         if (result == TCL_ERROR) {
  144.         printf("Error");
  145.         } else {
  146.         printf("Error %d", result);
  147.         }
  148.         if (*interp->result != 0) {
  149.         printf(": %s\n", interp->result);
  150.         } else {
  151.         printf("\n");
  152.         }
  153.     }
  154.     }
  155. }
  156.